Spatial Pattern Finding¶
Global Morans'I¶
1.Entry Rate¶
Global Morans'I = 0.146
2.HHI¶
Global Morans'I = 0.296
3.Asset¶
Global Morans'I = 0.025
LISA¶
1. Entry Rate¶
2. HHI¶
3. Asset¶
From the LISA, we can ascertain that there was statistically significant low clustering in England
High entry rate seems to locate on the boundaries of England.
The LISA Cluser Map shows how the attribute entry rate clusters. The red color shows tracts where high rate cluster with high rates, and blue shows where low rates cluster with low rates. There is even a mix of high-low, for example the pink color. So, there is a cluster of high entry rate in the southwest commute area and clusters of lower ownership in the north.
GWR¶
In (1)
classic
spatial lag
spatial error
In (2)
classic
spatial lag
spatial error
Reproducible Analysis¶
# read geojson data7
# df_mg.to_csv(PATH + "/HHI_EnR_ttwa_England_for_R.csv")
import geopandas as gpd
import fiona
import sys
PATH = sys.path[0]
# export the geojson
gdf = gpd.read_file(PATH + "/Dataset/Spatial/HHI_EnR_ttwa_England_for_R.geojson")
3 figures will be needed
| 1998 | 2008 | 2018 | |
|---|---|---|---|
| Entry Rate | fig1_a | fig1_b | fig1_c |
| HHI | fig2_a | fig2_b | fig2_c |
| Performance | fig3_a | fig3_b | fig3_c |
raw_data contains ttwa, year, entry_rate, hh, assets
In [ ]:
# environment prepare
library(tidyverse)
library(data.table)
library(sp)
library(sf)
library(table1)
library(tm)
library(spatstat)
library(here)
library(sp)
library(rgeos)
# library(maptools)
library(tmap)
library(sf)
library(geojson)
library(geojsonio)
library(tmaptools)
library(RColorBrewer)
library(spdep)
library(lubridate)
In [512]:
# read data in R
raw_data = read.csv(here::here("Dataset","df_hh_EnR_ttwaName_asset_not_drop.csv"))
# you can have a overview of this dataset
print("The number of rows is: ")
nrow(raw_data)
print("The number of columns is: ")
ncol(raw_data)
print("70 of all varriables are:")
head(names(raw_data),n = 70)
In [513]:
# import spatial dataset
eng_ttwa = st_read(here::here("Dataset","Spatial","eng_ttwa_boundary.geojson"))
In [514]:
# plot the map
plot(st_geometry(eng_ttwa))
In [515]:
dfm = merge(raw_data,eng_ttwa,by.x="ttwa_code",by.y="TTWA11CD",all = TRUE)
In [516]:
# calculate the density of tech firms in ttwa
# df merged & density is calculated
#dfm_den_cal = dfm %>%
# mutate(area=st_area(.))%>%
# mutate(density = firms*1000*1000/area)
#head(dfm_den_cal)
In [517]:
tmap_mode("plot")
Data Prepare¶
In [548]:
# select year
df_1998 = raw_data %>% filter(year==1998)
df_2008 = raw_data %>% filter(year==2008)
df_2018 = raw_data %>% filter(year==2018)
df_2017_2018 = raw_data %>% filter(year==2017 | year==2018)
# merge
dfm_1998 = merge(eng_ttwa,df_1998,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2008 = merge(eng_ttwa,df_2008,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2018 = merge(eng_ttwa,df_2018,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2017_2018 = merge(eng_ttwa,df_2017_2018,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_all = merge(eng_ttwa,raw_data,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
# n/a -> 0
dfm_1998 = dfm_1998 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_2008 = dfm_2008 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_2018 = dfm_2018 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_2017_2018 = dfm_2017_2018 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_all = dfm_all %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
In [519]:
cus_break = c(0,0.02,0.04,0.06,0.08,0.1,0.12,0.14,0.16,0.18,0.2,0.22,0.24,0.26,0.28,0.3,0.32,0.34,0.36,0.38,0.4)
df = dfm_2018
tm_shape(df) +
tm_polygons(col = "entry_rate",
legend.hist = TRUE,
title = "xx",
breaks = cus_break) +
tm_layout(legend.outside = TRUE) +
tm_borders()
Entry Rate¶
build the break
In [520]:
summary(dfm_all$entry_rate)
In [521]:
summary(dfm_1998$entry_rate)
In [522]:
summary(dfm_2008$entry_rate)
In [523]:
summary(dfm_2018$entry_rate)
In [549]:
# cus_break = c(0,0.01,0.02,0.03,0.08,0.1,0.12,0.14,0.16,0.18,0.2,0.22,0.24,0.26,0.28,0.3,0.32,0.34,0.36,0.38,0.4)
# cus_break = c(0,0.04,0.08,0.12,0.16,0.2,0.24,0.28,0.32,0.36,0.4)
# cus_break = c(0,0.01,0.04,0.16,0.32,0.4)
# cus_break = c(0,0.001,0.005,0.01,0.03,0.05,0.10,0.15,0.2,0.4)
# cus_break = c(0,0.002457,0.018182,0.035029,0.048236,0.12153,0.14328,0.16108,0.32)
cus_break = c(0.00,0.007,0.01,0.013,0.03,0.035,0.077,0.12153,0.14,0.16,0.32)
# library(viridis)
In [525]:
# adjust with the colour
# tmaptools::palette_explorer()
In [600]:
dfm %>% info
In [598]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_1998
map_var = "entry_rate"
spatial_var = "ttwa"
legend_name = "Entry Rate (1998)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 1998"
enR_1998_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
breaks =c(50,100,150)
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuPu", n = 12,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
enR_1998_map
# tmap_arrange(enR_1998_map,tm_tmp1)
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
In [579]:
head(dfm)
In [551]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2008
map_var = "entry_rate"
spatial_var = "ttwa"
legend_name = "Entry Rate (2008)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 2008"
enR_2008_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuPu", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
enR_2008_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
In [552]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2018
map_var = "entry_rate"
spatial_var = "ttwa"
legend_name = "Entry Rate (2018)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 2018"
enR_2018_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.65, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuPu", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
enR_2018_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
In [553]:
enR_tmap = tmap_arrange(enR_1998_map,enR_2008_map,enR_2018_map,ncol = 1)
enR_tmap
# enR_tmap %>% tmap_save(.,here("Img","map_entry_rate_1998_to_2018.png"),dpi = 300)
In [554]:
enR_tmap %>% tmap_save(.,here("Img","map_entry_rate_1998_to_2018.png"),dpi = 300)
In [555]:
# animation
library(viridis)
library(gifski)
enR_animation <- tm_shape(dfm_all) +
tm_polygons(
col = "entry_rate",
style = "cont",
pal = "BuGn"
) +
tm_facets(along = "year") +
tm_layout(legend.position = c("left", "bottom"))
tmap_animation(
enR_animation, filename = "enR.gif",
delay = 50, width = 2400, height = 1200
)
In [531]:
nrow(dfm_all)
HHI¶
In [532]:
summary(dfm_all$hh)
# cus_break = c(0.002457,0.018182,0.035029,0.048236,0.072000,0.312686 )
In [533]:
cus_break = c(0,0.03968,0.07292,0.10000,0.15342,0.15625,1.00000)
In [534]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_1998
map_var = "hh"
spatial_var = "ttwa"
legend_name = " Herfindahl-Hirschman Index (1998)"
title_name = "The Distribution of the Herfindahl-Hirschman Index of the England Tech Clusters(ttwa) in 1998"
hhi_1998_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuGn", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
hhi_1998_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
In [535]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2008
map_var = "hh"
spatial_var = "ttwa"
legend_name = " Herfindahl-Hirschman Index (2008)"
title_name = "The Distribution of the Herfindahl-Hirschman Index of the England Tech Clusters(ttwa) in 2008"
hhi_2008_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuGn", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
hhi_2008_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
In [536]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2018
map_var = "hh"
spatial_var = "ttwa"
legend_name = " Herfindahl-Hirschman Index (2018)"
title_name = "The Distribution of the Herfindahl-Hirschman Index of the England Tech Clusters(ttwa) in 2018"
hhi_2018_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuGn", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
hhi_2018_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
In [537]:
hh_tmap = tmap_arrange(hhi_1998_map,hhi_2008_map,hhi_2018_map,ncol=1)
hh_tmap
# enR_tmap %>% tmap_save(.,here("Img","map_entry_rate_1998_to_2018.png"),dpi = 300)
In [545]:
hh_tmap %>% tmap_save(.,here("Img","map_hh_1998_to_2018.png"),dpi = 300)
Performance¶
In [538]:
df_1998 = raw_data %>% filter(year==1998)
df_2008 = raw_data %>% filter(year==2008)
df_2018 = raw_data %>% filter(year==2018)
df_2016 = raw_data %>% filter(year==2016)
df_2017 = raw_data %>% filter(year==2017)
df_2017_2018 = raw_data %>% filter(year==2017 | year==2018)
# merge
dfm_1998 = merge(eng_ttwa,df_1998,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2008 = merge(eng_ttwa,df_2008,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2018 = merge(eng_ttwa,df_2018,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2017 = merge(eng_ttwa,df_2017,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2016 = merge(eng_ttwa,df_2016,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_all = merge(eng_ttwa,raw_data,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
build the custom breaks
In [539]:
dfm_all$average_assets %>% summary()
In [540]:
dfm_1998$average_assets %>% summary()
In [541]:
dfm_2008$average_assets %>% summary()
In [542]:
raw_data %>%
filter(.,year==2014)%>%
summary()
In [543]:
cus_break = c(0,56900,58518,60194,91560,135434,141180,202891,263037,5307552,8532989,18578409)
In [544]:
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2016
map_var = "average_assets"
spatial_var = "ttwa"
legend_name = "Entry Rate (2018)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 2018"
l1 = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.65, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "Blues", n = 7,
# pal = viridis(10, direction = -1),
# breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
l1
# assets_2018_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
Density of Tech Firms in ttwa of England¶
In [711]:
head(dfm_all)
In [715]:
dfm3 = dfm_all %>%
mutate(area = st_area(geometry))%>%
mutate(area_km = units::set_units(area,km^2))%>%
mutate(density = firms / area_km)%>%
select(TTWA11CD,ttwa,year,entry_rate,hh,average_assets,density,firms,area_km)
In [724]:
# 输出dfm3
dfm3 %>% write_csv(here("Dataset","year_ttwa_enR_hh_den.csv"))
In [649]:
df = dfm1 %>% filter(year==2018)
map_var = "density"
legend_name = " Density(1/km^2)"
title_name = "The Distribution of The Density of the England Tech Clusters(ttwa) in 2018"
den_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
palette = "BuGn", n = 20,
# breaks = cus_break,
title=legend_name,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
den_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
Moran's I¶
set a new coordsw
In [687]:
library(spdep)
In [726]:
df = dfm3%>%
st_transform(.,27700)
In [727]:
df %>% st_crs()
In [728]:
coordsW = df%>%
st_centroid()%>%
st_geometry()
In [733]:
plot(coordsW,axes=TRUE)
In [738]:
df %>% list(1)
In [739]:
df = df%>%
filter(year==2008)
group_by(TTWA11CD,year) %>%
summarise(
density = first(density),
ttwa = first(ttwa)
)
tm_shape(df) +
tm_polygons("density",
style="jenks",
palette="PuOr",
midpoint=NA,
# popup.vars=c("wardname", "density"),
title="Blue Plaque Density")
In [741]:
Eng_ttwa_nb <- df %>%
poly2nb(., queen=T)
Reference¶
Moran's I
https://en.wikipedia.org/wiki/Moran%27s_I
GWR
- Huang, B., Wu, B., & Barry, M. (2010). Geographically and temporally weighted regression for modeling spatio-temporal variation in house prices. International Journal of Geographical Information Science, 24(3), 383–401. doi:10.1080/13658810802672469
GWTR
- Fotheringham, A. S., Crespo, R., & Yao, J. (2015). Geographical and Temporal Weighted Regression (GTWR). Geographical Analysis, 47(4), 431–452. doi:10.1111/gean.12071